perm filename DSTO.F4[DRW,LCS] blob sn#525289 filedate 1980-07-23 generic text, type T, neo UTF8
	SUBROUTINE DSTO(LFT,JRT)
	DIMENSION F(512),FF(512)
	COMMON/D/ JD(4000),I(3,40000)
	INTEGER X1,Y1,X2,Y2
	DATA JFIRST/0/
	IF(JFIRST.EQ.0)CALL RDFUNC(FF)
C ALWAYS USES SAME FUNC. AFTER 1ST TIME
	JFIRST=-1
	DO 799 K=1,512
799	F(K)=FF(K)
	TYPE 199
	ACCEPT 299,MA
	IF(MA.EQ.' ')MA='M'
199	FORMAT(' ADD OR MULTIPLY '$)
299	FORMAT(A1)

	IF(MA.EQ.'M')GO TO 399
	TYPE 499
	ACCEPT 599,ADD
	DO 699 K=1,512
699	F(K)=F(K)*ADD
499	FORMAT(' ADD HOW MUCH? '$)
599	FORMAT(F)
399	W=JRT-LFT
	N=0
	JDONE=0
1	N=N+1
	IF(I(3,N))GO TO 2
	Z=(I(1,N)-LFT)/W
	L=511.*Z+1.5
	A=I(2,N)
	IF(MA.EQ.'M')GO TO 3
	I(2,N)=A+F(L)
	GO TO 1
3	I(2,N)=A*F(L)
	GO TO 1
2	RETURN
CCC2	N=1
	M=-1
	MY=-1
	X1=I(1,N)
	Y1=I(2,N)
	GO TO 10
11	RX=0
17	X1=X2
	Y1=Y2
10	N=N+1
	IF(I(3,N).GE.0)GO TO 19
	IF(M.AND.MY)RETURN
	JDONE=-1
	GO TO 15
19	X2=I(1,N)
	Y2=I(2,N)
	IF(I(3,N).EQ.0)GO TO 14
	IF(MY.GT.0)GO TO 330
	IF(M)GO TO 11
	GO TO 15
14	IF(M.GT.0)GO TO 230
	IF(Y1.NE.Y2)GO TO 130
	IF(MY)MY=N
	GO TO 10
330	M=MY
	GO TO 15
130	IF(MY.GT.0)GO TO 330
230	IF(X1.NE.X2)GO TO 13
	IF(M)M=N
	GO TO 10
13	IF(M)GO TO 11
15	L=N-2
530	IF(L-M.LE.0)GO TO 18
	DO 430 K=M,L
430	I(3,K)=2
18	M=-1
	MY=-1
	GO TO 11
C13	Z=X2-X1
C	R=Y2-Y1
C	R=Z/R
C CHECK FOR SAME ANGLE
C	IF(R.EQ.RX)GO TO 16
C	IF(M.GT.0)GO TO 15
C	RX=R
C	GO TO 17
C16	IF(M)M=N
C	GO TO 17
 	END